home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.09 Sep 89 / Data Editor Source / FaceMF.inc < prev    next >
Encoding:
Text File  |  1988-01-27  |  2.3 KB  |  70 lines  |  [TEXT/EDIT]
  1.     SUBROUTINE FaceIt(w1,m1,m2,m3,m4,m5)
  2.     implicit none
  3.     INTEGER FRONTWINDOW,GETRESOURCE,HIDEWINDOW,OPENRESFILE,PTR
  4.     INTEGER TEINIT,INITDIALOGS,BLOCKMOVE
  5.     PARAMETER (BLOCKMOVE=Z'02E98008')
  6.     PARAMETER (FRONTWINDOW = Z'92480000')
  7.     PARAMETER (GETRESOURCE = Z'9A091000')
  8.     PARAMETER (HIDEWINDOW = Z'91610000')
  9.     PARAMETER (OPENRESFILE = Z'99770000')
  10.     PARAMETER (PTR = Z'C0000000')
  11.     PARAMETER (TEINIT = Z'9CC00000')
  12.     PARAMETER (INITDIALOGS = Z'97B10000')
  13.     character*4 ftype1
  14.     character*256 MAC,name,STR255,CHR256
  15.     integer*4 w1,m1,m2,m3,m4,m5,FACEhdl,toolbx,saveAppl(3)
  16.     integer*4 storage(512)
  17.       common/macstuff/storage
  18.       equivalence (storage(253),ftype1)
  19.     equivalence (storage(261),FACEhdl)
  20.       equivalence (storage(385),MAC)
  21.       equivalence (storage(449),name)
  22.     if (m2 = -1) then                  !first call to FaceIt?
  23.       call toolbx(TEINIT)              !perform Mac initializations
  24.       call toolbx(INITDIALOGS,0)
  25.       call toolbx(HIDEWINDOW,(toolbx(FRONTWINDOW)))  !hide MF window
  26.       ftype1 = 'FACE'
  27.       if (toolbx(GETRESOURCE,ftype1,1000) = 0) then  !find FaceIt glue
  28.         name = STR255(name)
  29.         if (toolbx(OPENRESFILE,name) < 0) stop       !or quit
  30.       end if
  31.       FACEhdl = toolbx(GETRESOURCE,ftype1,1000)      !store glue handle
  32.     end if
  33.     storage(49) = w1              !update window I/O #
  34.     storage(50) = m1              !update macro commands
  35.     storage(51) = m2
  36.     storage(52) = m3
  37.     storage(53) = m4
  38.     storage(54) = m5
  39.     if (m1 = 3).or.(m1 = 4) then  !preserve trailing spaces for
  40.       MAC(256:256) = 'x'          !use in dialogs & alerts only
  41.       name(256:256) = 'x'
  42.     end if
  43.     MAC = STR255(MAC)             !Fortran-to-Pascal string conversion
  44.     name = STR255(name)
  45.     !save & later restore ApplScratch global memory
  46.     call toolbx(BLOCKMOVE,Z'A78',toolbx(PTR,saveAppl),12)
  47.     long(Z'A80') = toolbx(PTR,storage)    !save storage address
  48.     call JumpMF                       !jump to FaceIt glue
  49.     call toolbx(BLOCKMOVE,toolbx(PTR,saveAppl),Z'A78',12)
  50.     MAC = CHR256(MAC)             !Pascal-to-Fortran string conversion
  51.     name = CHR256(name)
  52.     end
  53.  
  54.     character*256 FUNCTION STR255(string)
  55.     character*(*) string
  56.     i = len(trim(string))
  57.     if (i = 256) i = 255
  58.     STR255 = char(i)//string
  59.     end
  60.  
  61.     character*256 FUNCTION CHR256(string)
  62.     character*(*) string
  63.     i = ichar(string(1:1))
  64.     if (i > 0) then
  65.       CHR256 = string(2:i+1)
  66.     else
  67.       CHR256 = ' '
  68.     end if
  69.     end
  70.